home *** CD-ROM | disk | FTP | other *** search
/ The Pier Shareware 1 / Pier Shareware 1.iso / 007a / courspas.exe / CHAP11.EXE / TYP4.PAS < prev   
Pascal/Delphi Source File  |  1991-01-06  |  3KB  |  120 lines
  1. program supprimElement; {TYP4.PAS}
  2. uses
  3.   crt;  { unité de Turbo Pascal 6 }
  4.  
  5. const
  6.   nom = 'TESTSTR.DAT';  { fichier sur disquette }
  7.  
  8. type
  9.   str20 = string[20];
  10.  
  11. var
  12.   element: str20;
  13.   f      : file of str20;
  14.  
  15. {------------------------------------------------}
  16. { attendre                                         }
  17. {------------------------------------------------}
  18. procedure attendre;
  19. var  ch: char;
  20. begin
  21.   gotoxy(1,25); write('Veuillez appuyer sur une touche...');
  22.   ch:= readkey;
  23.   gotoxy(1,25); clreol
  24. end;
  25. {------------------------------------------------}
  26. { lireElements                                  }
  27. {------------------------------------------------}
  28. procedure lireElements;
  29. var  i: integer; { compteur }
  30.  
  31. begin
  32.   clrscr;
  33.   seek(f,0);   { pointeur au début du fichier }
  34.   writeln('Liste des éléments du fichier:');
  35.   writeln;
  36.   writeln('Nombre d''éléments: ',filesize(f));
  37.   writeln;
  38.   i:= -1;   { valeur de début }
  39.   while not eof(f) do
  40.   begin
  41.     inc(i);           { i:= i+1, pour compter}
  42.     read(f,element);  { lecture des éléments }
  43.     writeln(i:3,': ',element); { affichage}
  44.   end; { while }
  45. end;
  46. {------------------------------------------------}
  47. { suppression                                       }
  48. {------------------------------------------------}
  49. procedure suppression(supprElement: longint);
  50. var  i: longint; { compteur }
  51. begin
  52.   if supprElement = filesize(f)-1
  53.   then begin
  54.          { Si la suppression concerne }
  55.          { le dernier élément, nous ne}
  56.          { faisons rien, il sera de   }
  57.          { toute façon supprimé!      }
  58.        end
  59.   else begin
  60.          for i:= supprElement+1 to (filesize(f)-1) do
  61.          begin
  62.            seek(f,i);        { élément suivant       }
  63.            read(f,element);  { lecture de l'élément  }
  64.            seek(f,(i-1));    { revenir d'un élément  }
  65.            write(f,element); { écriture de l'élément }
  66.          end; { for }
  67.        end; { else }
  68.   seek(f,(filesize(f)-1));   { dernier élément       }
  69.   truncate(f);               { tronquer le fichier   }
  70. end;
  71. {------------------------------------------------}
  72. { dialogue                                         }
  73. {------------------------------------------------}
  74. procedure dialogue;
  75. var  position,
  76.      nombr      : longint;
  77. begin
  78.   nombr:= filesize(f);
  79.   if nombr = 0 then
  80.   begin
  81.     clrscr;
  82.     writeln('Le fichier ne contient aucun élément');
  83.     writeln('à supprimer!                         ');
  84.     attendre;
  85.   end else
  86.   begin
  87.     repeat
  88.       gotoxy(1,24);
  89.       write('Quel élément désirez-vous supprimer?: ');
  90.       readln(position);
  91.     until (position >= 0) and (position <= nombr-1);
  92.     suppression(position);
  93.   end; { else }
  94. end;
  95. {------------------------------------------------}
  96.  
  97. begin { programme principal }
  98.   clrscr;
  99.   assign(f,nom);   { liaison des fichiers        }
  100.   {$I-}            { inhibe la détect. d'erreurs }
  101.   reset(f);        { ouvre le fichier précédent  }
  102.   {$I+}            { rétabl. la détect. d'erreurs }
  103.   if ioResult = 0
  104.   then begin
  105.          lireElements;
  106.          dialogue;
  107.          lireElements;
  108.          attendre;
  109.          close(f);
  110.        end
  111.   else begin
  112.          writeln('Erreur à l''ouverture');
  113.          writeln('du fichier!        ');
  114.          writeln;
  115.          writeln('Prog.interrompu!  ');
  116.          attendre;
  117.        end;
  118.   clrscr;
  119. end.
  120.